home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip Kasım 2000.iso / prog / share / 11 / setup.exe / %MAINDIR% / DEMOS / CIHTTP / HTTPEXP / session.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-09-07  |  7.3 KB  |  201 lines
  1. VERSION 5.00
  2. Object = "{DE90AEA0-1461-11CF-858F-0080C7973784}#1.1#0"; "CIHTTP.OCX"
  3. Begin VB.Form Session 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "HTTP Session - (Background)"
  6.    ClientHeight    =   2700
  7.    ClientLeft      =   1245
  8.    ClientTop       =   1935
  9.    ClientWidth     =   4590
  10.    Icon            =   "Session.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    PaletteMode     =   1  'UseZOrder
  16.    ScaleHeight     =   2700
  17.    ScaleWidth      =   4590
  18.    ShowInTaskbar   =   0   'False
  19.    Begin VB.ListBox lstAnchors 
  20.       BackColor       =   &H00FFFFFF&
  21.       BeginProperty Font 
  22.          Name            =   "Courier New"
  23.          Size            =   9
  24.          Charset         =   0
  25.          Weight          =   400
  26.          Underline       =   0   'False
  27.          Italic          =   0   'False
  28.          Strikethrough   =   0   'False
  29.       EndProperty
  30.       ForeColor       =   &H00000000&
  31.       Height          =   2085
  32.       Left            =   0
  33.       TabIndex        =   1
  34.       Top             =   600
  35.       Width           =   2355
  36.    End
  37.    Begin CIHTTPLib.CIHTTP HTTPControl 
  38.       Height          =   450
  39.       Left            =   1905
  40.       Top             =   75
  41.       Width           =   480
  42.       _Version        =   65537
  43.       _ExtentX        =   847
  44.       _ExtentY        =   794
  45.       _StockProps     =   0
  46.       FileClosedWAV   =   ""
  47.       HTTPServerConnectionWAV=   ""
  48.       HTTPServerConnectionClosedWAV=   ""
  49.       ListBoxesPopulatedWAV=   ""
  50.       PacketReceivedWAV=   ""
  51.       PacketSentWAV   =   ""
  52.       SocketClosedWAV =   ""
  53.       WSAErrorWAV     =   ""
  54.       URL             =   ""
  55.       HostName        =   ""
  56.       HostAddress     =   ""
  57.       ProxyServerName =   ""
  58.       ProxyServerAddress=   ""
  59.       LocalFileName   =   "c:\$$cihttp.tmp"
  60.    End
  61.    Begin VB.Label lblReadMe 
  62.       AutoSize        =   -1  'True
  63.       Caption         =   "List of anchors. 'Bound' to CIHTTP control."
  64.       ForeColor       =   &H00800000&
  65.       Height          =   390
  66.       Index           =   1
  67.       Left            =   2490
  68.       TabIndex        =   2
  69.       Top             =   885
  70.       Width           =   1890
  71.       WordWrap        =   -1  'True
  72.    End
  73.    Begin VB.Label lblReadMe 
  74.       Caption         =   "Crescent HTTP Control"
  75.       ForeColor       =   &H00800000&
  76.       Height          =   195
  77.       Index           =   0
  78.       Left            =   2490
  79.       TabIndex        =   0
  80.       Top             =   255
  81.       Width           =   1995
  82.       WordWrap        =   -1  'True
  83.    End
  84. Attribute VB_Name = "Session"
  85. Attribute VB_GlobalNameSpace = False
  86. Attribute VB_Creatable = False
  87. Attribute VB_PredeclaredId = True
  88. Attribute VB_Exposed = False
  89. Option Explicit
  90. '<Public>---------------------------------------------
  91. Public Connected        As Boolean
  92. Public GotPage          As Boolean
  93. Public TimedOut         As Boolean
  94. Public ServerNode       As Node
  95. Public ThisExplorer     As Form
  96. Public ThisCallback     As HTTPCallback
  97. Public ThisServer       As HTTPServer
  98. Public WWWSiteName      As String
  99. Public WorkingDir       As String
  100. '</Public>--------------------------------------------
  101. '<Private>--------------------------------------------
  102. Private Alias           As String
  103. Private GetListing      As Boolean
  104. '</Private>-------------------------------------------
  105. Private Sub Form_Load()
  106.     '---- "Bind" the ListBoxes
  107.     With HTTPControl
  108.         Set .AnchorListBoxName = lstAnchors
  109.     End With
  110. End Sub
  111. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  112.     'HTTPControl.QUIT
  113. End Sub
  114. Private Sub Form_Terminate()
  115.     '---- explicitly destroy all objects
  116.     Set ServerNode = Nothing
  117.     Set ThisExplorer = Nothing
  118.     Set ThisCallback = Nothing
  119.     Set ThisServer = Nothing
  120. End Sub
  121. '----------------------------------------------------
  122. '<Purpose> forces this form to transfer data from the
  123. ' HTTPServer class object into the HTTP Control
  124. '----------------------------------------------------
  125. Public Sub InitSession()
  126.     Alias = ThisServer.Alias
  127.     With HTTPControl
  128.         If (WorkingDir = "") Then
  129.             .URL = ThisServer.DefaultURL
  130.         Else
  131.             .URL = WorkingDir
  132.         End If
  133.         
  134.         If ThisServer.UseProxy Then
  135.             .ProxyServerName = ThisServer.ProxyName
  136.             .HostName = ""
  137.             '---- append the host name for proxy servers
  138.             .URL = "http://" & ThisServer.HostName & .URL
  139.         Else
  140.             .ProxyServerName = ""
  141.             .HostName = ThisServer.HostName
  142.         End If
  143.         
  144.     End With
  145.     Call Status.ShowStatus("Looking for URL: " & HTTPControl.URL, , , "Search", vbBlue)
  146. End Sub
  147. '-----------------------------------------------------
  148. '<Purpose> creates an HTTP connection
  149. '-----------------------------------------------------
  150. Public Sub Connect()
  151.     Connected = False
  152.     GotPage = False
  153.     TimedOut = False
  154.     GetListing = True
  155.     lstAnchors.Clear
  156.     HTTPControl.ConnectToHTTPServer
  157.     Call Status.ShowStatus(Alias & ": connecting for directories and files", , , "Status", vbBlue)
  158. End Sub
  159. Private Sub HTTPControl_HTTPServerConnection()
  160.   '---- HTTP request uses the URL property
  161.   HTTPControl.GET
  162. End Sub
  163. '--------------------------------------------------------
  164. '<Purpose> this standard event will fire once all of the
  165. ' asynchronous listing is completed; at this time call
  166. ' the callback functions to add the info to the Explorer
  167. '--------------------------------------------------------
  168. Private Sub HTTPControl_ListBoxesPopulated()
  169.     GotPage = True
  170.     Call Status.ShowStatus(Alias & ": got directories and files; adding to TreeView", , , "Status", vbBlue)
  171.     WWWSiteName = HTTPControl.WWWSiteName
  172.     If GetListing Then
  173.         '---- turn off redraw on TreeView and ListView
  174.         Call SendMessage(ThisExplorer.Tree.hwnd, WM_SETREDRAW, REDRAWOFF, 0&)
  175.         Call SendMessage(ThisExplorer.List.hwnd, WM_SETREDRAW, REDRAWOFF, 0&)
  176.         
  177.         Call ThisCallback.ShowAnchors(Me, ThisExplorer, ServerNode)
  178.         
  179.         '---- set some properties on the explorer
  180.         ThisExplorer.StatusBar.Panels(1).Text = ThisExplorer.List.ListItems.Count & " object(s)"
  181.         ThisExplorer.Tree.Nodes(ServerNode.Key).Expanded = True
  182.         
  183.         '---- turn redraw back on
  184.         Call SendMessage(ThisExplorer.Tree.hwnd, WM_SETREDRAW, REDRAWON, 0&)
  185.         Call SendMessage(ThisExplorer.List.hwnd, WM_SETREDRAW, REDRAWON, 0&)
  186.         
  187.         ThisExplorer.MousePointer = vbDefault
  188.     End If
  189. End Sub
  190. Private Sub HTTPControl_PacketReceived(ByVal Packet As String, ByVal bytes_in As Integer)
  191.     '---- packet received on the access control channel
  192.     Call Status.ShowStatus(Alias & vbCrLf & EOL2CrLf(Packet), , , "Packet", vbRed)
  193. End Sub
  194. Private Sub HTTPControl_WSAError(ByVal error_number As Integer)
  195.     If (error_number = WSAETIMEDOUT) Then
  196.         TimedOut = True
  197.     End If
  198.     Call Status.ShowStatus(Alias & ": a WSA error occurred - " & error_number, vbRed, True, "Error", vbBlack)
  199.     ThisExplorer.MousePointer = vbDefault
  200. End Sub
  201.